Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE13/SYSTEM/HELPINFO.PAS

Pascal/Delphi Source File | 1996-08-03 | 19.0 KB | 590 lines

unit HelpInfo;

{
    Probs:

    = The GenDate stuff is seconds since 0:0:0 1/1/70

    }

interface

uses WinTypes, WinProcs, SysUtils;

const
    HBadOpen = 1000;           { Can't open the help file   }
    HIOError = 1001;           { I/O Error reading the file }
    HBadSig  = 1002;           { Not a Windows Help file    }
    HNoSys   = 1003;           { |SYSTEM file is missing !  }

function  OpenHelpFile (fileName: PChar; var hFile: Pointer): Integer;
function  GetHelpFileName (hFile: Pointer): PChar;
function  GetHelpFileSize (hFile: Pointer): LongInt;
function  GetHelpFileDate (hFile: Pointer): PChar;
function  GetHelpFileVersion (hFile: Pointer): Word;
function  GetHelpFileCopyright (hFile: Pointer): PChar;
function  GetHelpFileTitle (hFile: Pointer): PChar;
function  GetHelpFileMacroCount (hFile: Pointer): Integer;
function  GetHelpFileMacro (hFile: Pointer; idx: Integer): PChar;
function  GetHelpFileFileCount (hFile: Pointer): Integer;
function  GetHelpFileFileName (hFile: Pointer; idx: Integer): PChar;
function  GetHelpFileFileSize (hFile: Pointer; idx: Integer): LongInt;
{function  GetHelpFileGenDate (hFile: Pointer): PChar;}
function  GetHelpFileCompression (hFile: Pointer): PChar;
procedure CloseHelpFile (hFile: Pointer);

implementation

type
    { Header for entire .HLP file }
    THFileHeader = record
                      MagicNumber: LongInt;
                      WHIFSOffset: LongInt;
                      Negative: LongInt;
                      FileSize: LongInt;
                  end;

    { Header for each internal WHIFS file }
    TFileHeader = record
              FilePlusHdr: LongInt;        { size with header }
              FileSize:    LongInt;        { size without header }
              NullByte: Byte;            { always zero... }
          end;

    TWHIFSHeader = record
                      Magic: array [0..17] of Byte;
                      Junk: array [0..12] of Byte;
                      Zero, NSplits, RootPage, MinusOne: Integer;
                      TotPages, NLevels: Integer;
                      TotalWHIFSEntries: LongInt;
                   end;

    PSysHeader = ^TSysHeader;
    TSysHeader = record
                     Magic, Version, Revision, Zero: Byte;
                     AlwaysOne: Word;
                     GenDate: LongInt;
                     Flags: Word;
                 end;

    PHelpHandle = ^THelpHandle;
    THelpHandle = record
                      _fd: Integer;                       { handle of open help file     }
                      _fn: String;                        { full pathname of the file    }
                      _scratch1: array [0..255] of Char;  { scratch buffer             }
                      _WHIFSStart: LongInt;               { start of file system         }
              _FirstLeaf: Integer;          { first leaf node number       }
                      _Title: array [0..255] of Char;     { help system title            }
                      _Copyright: array [0..255] of Char; { help system copyright        }
                      _MacroCount: Integer;               { number of startup macros     }
                      _MacroData: PChar;                  { pointer to macro data        }
                      _MacroDataSize: Word;               { size of _MacroData pointer   }
                      _FileCount: Integer;                { # of files in help system    }
                      _System: PSysHeader;                { pointer to in-memory |SYSTEM }
                      _FileDirectory: Pointer;            { pointer to file directory    }
                 end;

{------------------------------------------------------------------------------}
{     Name:     GotoWHIFSPage                                                  }
{     Purpose:  Internal routine - seek to a specified WHIFS page              }
{------------------------------------------------------------------------------}
procedure GotoWHIFSPage (p: PHelpHandle; pageNum: LongInt);
begin
    with p^ do _llseek (_fd, _WHIFSStart + (pageNum * 1024), 0);
end;

{------------------------------------------------------------------------------}
{     Name:     ReadString                                                     }
{     Purpose:  Internal routine - just read a zero terminated string          }
{------------------------------------------------------------------------------}
procedure ReadString (fd: Integer; dest: PChar);
begin
    while True do
    begin
        _lread (fd, dest, 1);
        if dest^ = #0 then break;
        Inc (dest);
    end;
end;

{------------------------------------------------------------------------------}
{     Name:     FindWHIFSFile                                                  }
{     Purpose:  Internal routine - find a specified WHIFS file                 }
{------------------------------------------------------------------------------}
function FindWHIFSFile (p: PHelpHandle; fileName: PChar): LongInt;
var
    count: Integer;
    fEntry: ^PChar;
begin
    FindWHIFSFile := -1;
    with p^ do
    begin
        fEntry := _FileDirectory;
        for count := 0 to _FileCount - 1 do
        begin
            if lstrcmp (fileName, fEntry^) = 0 then
            begin
                FindWHIFSFile := PLongInt (fEntry^ + lstrlen (fEntry^) + 1)^;
                Exit;
            end;
            Inc (fEntry);
        end;
    end;
end;

{------------------------------------------------------------------------------}
{     Name:     ReadFileDirectory                                              }
{     Purpose:  Internal routine - Read the file directory into memory.        }
{------------------------------------------------------------------------------}
procedure ReadFileDirectory (p: PHelpHandle);
type
    Node = record
               Sig, Entries, Prev, Next: Integer;
           end;
var
    f: Integer;
    fEntry: ^PChar;
    WHIFSNode: Node;
    fname: array [0..255] of Char;

begin
    with p^ do
    begin
        { Allocate memory for directory structure }

        _FileDirectory := AllocMem (_FileCount * sizeof (PChar));
        fEntry := _FileDirectory;

        { Second pass - read the file directory }

        GotoWHIFSPage (p, _FirstLeaf);
        while True do
        begin
            _lread (_fd, @WHIFSNode, sizeof (WHIFSNode));
            for f := 1 to WHIFSNode.Entries do
            begin
                ReadString (_fd, fname);
                fEntry^ := AllocMem (lstrlen (fname) + 1 + sizeof (LongInt));
                lstrcpy (fEntry^, fname);
                _lread (_fd, fEntry^ + lstrlen (fName) + 1, sizeof (LongInt));
                Inc (fEntry);
            end;

            if WHIFSNode.Next = -1 then break;
            GotoWHIFSPage (p, WHIFSNode.Next);
        end;
    end;
end;

function LoadSystem (p: PHelpHandle): Integer;
const
    hpj_Title     = 1;                { title string }
    hpj_Copyright = 2;                { copyright string }
    hpj_Contents  = 3;                { contents }
    hpj_MacroData = 4;
    hpj_IconData  = 5;
    hpj_SecWindow = 6;
    hpj_Citation  = 8;
var
    Data: array [0..1] of Word;
    DataPtr: PChar;

    bytesRead: LongInt;
    sysOffset: LongInt;
    fhdr: TFileHeader;
    szBuffer: array [0..255] of Char;

    procedure AddMacro (macro: PChar);
    var
        sz: Word;
    begin
        with p^ do
        begin
            sz := lstrlen (macro) + 1;
            if _MacroData = Nil then _MacroData := AllocMem (sz)
            else _MacroData := ReAllocMem (_MacroData, _MacroDataSize, _MacroDataSize + sz);
            lstrcpy (_MacroData + _MacroDataSize, macro);
            Inc (_MacroDataSize, sz);
            Inc (_MacroCount);
        end;
    end;

begin
    LoadSystem := 0;
    with p^ do
    begin
        sysOffset := FindWHIFSFile (p, '|SYSTEM');
    if sysOffset = -1 then LoadSystem := HNoSys else
     begin
        { Read file header for |SYSTEM file }

        _llseek (_fd, sysOffset, 0);
            _lread (_fd, @fhdr, sizeof (fhdr));
            GetMem (_System, sizeof (TSysHeader));
            _lread (_fd, PChar (_System), sizeof (TSysHeader));

            { Is it ancient ?  If so, title string only }

            if _System^.Revision = $F then
            begin
                _lread (_fd, _Title, 33);
                Exit;
            end;

            { Now, grab any stuff that follows system header }
            { It's organised as <Type><Size><Data>,,,<Type><Size><Data> }

            bytesRead := sizeof (TSysHeader);
            while fhdr.FileSize > bytesRead do
            begin
                _lread (_fd, @Data, sizeof (Data));
                GetMem (DataPtr, Data [1]);
                _lread (_fd, DataPtr, Data [1]);

                { Now case out on the data type }
                case Data [0] of
                    hpj_Title:      lstrcpy (_Title, DataPtr);
                    hpj_Copyright:  if DataPtr^ <> #0 then lstrcpy (_Copyright, DataPtr)
                                    else lstrcpy (_Copyright, 'None');
                    hpj_MacroData:  AddMacro (DataPtr);
                end;

                FreeMem (DataPtr, Data [1]);
                Inc (bytesRead, Data [1] + sizeof (Data));
            end;
    end;
    end;
end;

function OpenHelpFile (fileName: PChar; var hFile: Pointer): Integer;
var
    aPage: Word;
    junk: LongInt;
    hdr: THFileHeader;
    whdr: TWHIFSHeader;
    f, fd, ret: Integer;
    p: PHelpHandle absolute hFile;

begin
    ret := 0;
    hFile := Nil;
    fd := _lopen (fileName, 0);
    if fd = -1 then ret := HBadOpen else
    if _lread (fd, @hdr, sizeof (hdr)) <> sizeof (hdr) then ret := HIOError else
    if hdr.MagicNumber <> $00035F3F then ret := HBadSig;

    if ret = 0 then
    begin
        CloseHelpFile (hFile);
        p := AllocMem (sizeof (THelpHandle));
        p^._fd := fd;
        p^._fn := StrPas (fileName);
        lstrcpy (p^._Title, 'None');
        lstrcpy (p^._Copyright, 'None');
        p^._WHIFSStart := hdr.WHIFSOffset + sizeof (whdr);

        { Read the WHIFS header }

        _llseek (fd, hdr.WHIFSOffset, 0);
        _lread (fd, @whdr, sizeof (whdr));
        p^._FileCount := whdr.TotalWHIFSEntries;

    { and find root page }

        f := 1;
        aPage := 0;
        GotoWHIFSPage (p, whdr.RootPage);
        while f < whdr.NLevels do
        begin
            _lread (fd, @junk, sizeof (junk));
            _lread (fd, @aPage, sizeof (aPage));
            GotoWHIFSPage (p, aPage);
            Inc (f);
        end;

        p^._FirstLeaf := aPage;

        { Read directory and load the |SYSTEM file }

        ReadFileDirectory (p);
        ret := LoadSystem (p);

    end
    else if fd <> -1 then _lclose (fd);

    OpenHelpFile := ret;
end;

{------------------------------------------------------------------------------}
{     Name:     GetHelpFileName                                                }
{     Purpose:  Return full pathname of the current help file                  }
{------------------------------------------------------------------------------}
function GetHelpFileName (hFile: Pointer): PChar;
var
    p: PHelpHandle absolute hFile;
begin
    GetHelpFileName := '';
    if hFile <> Nil then with p^ do
    begin
        StrPCopy (_scratch1, _fn);
        GetHelpFileName := _scratch1;
    end;
end;

function GetHelpFileDate (hFile: Pointer): PChar;
var
    dt: TDateTime;
    p: PHelpHandle absolute hFile;
begin
    GetHelpFileDate := '';
    if hFile <> Nil then with p^ do
    begin
        dt := FileDateToDateTime (FileGetDate (_fd));
        GetHelpFileDate := StrPCopy (_scratch1, FormatDateTime ('dddd, mmmm d, yyyy "at" hh:mm AM/PM', dt));
    end;
end;

function GetHelpFileVersion (hFile: Pointer): Word;
var
    p: PHelpHandle absolute hFile;
begin
    GetHelpFileVersion := $ffff;
    if hFile <> Nil then with p^._System^ do
        GetHelpFileVersion := (Revision shl 8) + Version;
end;

{
    This doesn't work because _GenDate is actually the number of seconds since
    00:00:00 GMT Jan 1, 1970.  Bummer.....

function GetHelpFileGenDate (hFile: Pointer): PChar;
var
    dt: TDateTime;
    p: PHelpHandle absolute hFile;
begin
    GetHelpFileGenDate := '';
    if hFile <> Nil then with p^ do
    begin
        dt := FileDateToDateTime (_System^.GenDate);
        GetHelpFileGenDate := StrPCopy (_scratch1, FormatDateTime ('dddd, mmmm d, yyyy "at" hh:mm AM/PM', dt));
    end;
end;   }

function GetHelpFileCompression (hFile: Pointer): PChar;
var
    Comp: Byte;
    psz: PChar;
    p: PHelpHandle absolute hFile;
begin
    GetHelpFileCompression := '';
    if hFile <> Nil then with p^ do
    begin
        Comp := Lo (p^._System^.Flags);
        if Comp = 0 then psz := 'None' else
        if (Comp and $C) <> 0 then psz := 'Compressed' else
        psz := 'Unknown';
        GetHelpFileCompression := lstrcpy (_scratch1, psz);
    end;
end;

function GetHelpFileCopyright (hFile: Pointer): PChar;
var
    p: PHelpHandle absolute hFile;
begin
    GetHelpFileCopyright := '';
    if hFile <> Nil then GetHelpFileCopyright := p^._Copyright;
end;

function GetHelpFileTitle (hFile: Pointer): PChar;
var
    p: PHelpHandle absolute hFile;
begin
    GetHelpFileTitle := '';
    if hFile <> Nil then GetHelpFileTitle := p^._Title;
end;

function GetHelpFileSize (hFile: Pointer): LongInt;
var
    p: PHelpHandle absolute hFile;
begin
    GetHelpFileSize := 0;
    if hFile <> Nil then GetHelpFileSize := _llseek (p^._fd, 0, 2);
end;

function GetHelpFileMacroCount (hFile: Pointer): Integer;
var
    p: PHelpHandle absolute hFile;
begin
    GetHelpFileMacroCount := 0;
    if hFile <> Nil then GetHelpFileMacroCount := p^._MacroCount;
end;

function GetHelpFileFileCount (hFile: Pointer): Integer;
var
    p: PHelpHandle absolute hFile;
begin
    GetHelpFileFileCount := 0;
    if hFile <> Nil then GetHelpFileFileCount := p^._FileCount;
end;

function GetHelpFileMacro (hFile: Pointer; idx: Integer): PChar;
var
    psz: PChar;
    p: PHelpHandle absolute hFile;
begin
    GetHelpFileMacro := '';
    if (hFile <> Nil) and (idx < p^._MacroCount) then with p^ do
    begin
        psz := _MacroData;
        while idx <> 0 do
        begin
            Inc (psz, lstrlen (psz) + 1);
            Dec (idx);
        end;

        GetHelpFileMacro := lstrcpy (_scratch1, psz);
    end;
end;

function GetHelpFileFileName (hFile: Pointer; idx: Integer): PChar;
var
    fEntry: ^PChar;
    p: PHelpHandle absolute hFile;
begin
    GetHelpFileFileName := '';
     if (hFile <> Nil) and (idx < p^._FileCount) then with p^ do
     begin
         fEntry := _FileDirectory;
         Inc (fEntry, idx);
         GetHelpFileFileName := lstrcpy (_scratch1, fEntry^);
     end;
end;

function GetHelpFileFileSize (hFile: Pointer; idx: Integer): LongInt;
var
    offset: LongInt;
    fhdr: TFileHeader;
    p: PHelpHandle absolute hFile;
begin
    GetHelpFileFileSize := 0;
    if (hFile <> Nil) and (idx < p^._FileCount) then with p^ do
    begin
        offset := FindWHIFSFile (p, GetHelpFileFileName (p, idx));
        { Read the file header in order to get the file size }
        _llseek (_fd, offset, 0);
        _lread (_fd, @fhdr, sizeof (fhdr));
        GetHelpFileFileSize := fhdr.FileSize;
    end;
end;

procedure CloseHelpFile (hFile: Pointer);
var
    count: Integer;
    fEntry: ^PChar;
    p: PHelpHandle absolute hFile;
begin
    if hFile <> Nil then with p^ do
    begin
        _lclose (_fd);
        if _System <> Nil then FreeMem (_System, sizeof (TSysHeader));
        if _MacroDataSize <> 0 then FreeMem (_MacroData, _MacroDataSize);

        if _FileDirectory <> Nil then
        begin
            fEntry := _FileDirectory;
            { First kill individual entries }
            for count := 0 to _FileCount - 1 do
            begin
                FreeMem (fEntry^, lstrlen (fEntry^) + 1 + sizeof (LongInt));
                Inc (fEntry);
            end;
            { Then kill directory itself }
            FreeMem (_FileDirectory, _FileCount * sizeof (PChar));
        end;
        FreeMem (hFile, sizeof (THelpHandle));
    end;
end;

{-----------------------------------------------------------------------------------}
{    Name:        Decompress                                                  }
{    Purpose:    Decompress file data using Microsoft's "octet-based" LZ77   }
{            sliding window algorithm.                                   }
{    Parameters:    fd         ----   handle to the input file.                 }
{            RawBytes   ----   number of bytes of input to process.      }
{            Buffer     ----   destination buffer for decompressed data. }
{-----------------------------------------------------------------------------------}

function Decompress (fd: Integer; RawBytes: Word; Buffer: PChar): Word;
var
    cc: Integer;                      { general dog's-body            }
    win, wout: Word;                  { input/output byte counts      }
    map: Byte;                        { the flag (or map) byte        }
    octet: array [0..15] of Byte;     { bytes following map byte      }
    octetSize: Integer;               { # of bytes specified by map   }
    back: PChar;                      { backtrack pointer             }
    count, index, len, dist: Integer; { stuff for backtracking        }

begin
    win := 0;
    wout := 0;

    { Repeat until read all bytes requested }

    while win < RawBytes do
    begin
        { Read map byte and figure out how many more bytes to read }

        octetSize := 8;
        _lread (fd, @map, sizeof (map));
        for cc := 0 to 7 do
            if (map and (1 shl cc)) <> 0 then
                Inc (octetSize);

        { Ensure no overrun at end of compressed data }

        if RawBytes - win < octetSize then octetSize := RawBytes - win;

        _lread (fd, @octet, octetSize);
        Inc (win, octetSize + 1);

        { Repeat for each of the eight bits of the flag byte }

        index := 0;
        for count := 0 to 7 do
        begin
            if (map and (1 shl count)) = 0 then
            begin
                { It's a literal - just copy it }

                Buffer^ := Char (octet [index]);
                Inc (Buffer);
                Inc (index);
                inc (wout);
            end
            else
            begin
                { It's a length/distance pair }

               len := ((octet [index + 1] and $F0) shr 4) + 3;
               dist := (256 * (octet [index + 1] and 15)) +
                              octet [index] + 1;
               back := Buffer - dist;
               Inc (wout, len);
               while len <> 0 do
               begin
                   Dec (len);
                   Buffer^ := back^;
                   Inc (Buffer);
                   Inc (back);
               end;

               Inc (index, 2);
            end
        end;
    end;

    Decompress := wout;
end;

end.